library(tidyverse)
Registered S3 methods overwritten by 'dbplyr':
method from
print.tbl_lazy
print.tbl_sql
── Attaching packages ───────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.2 ──✔ ggplot2 3.4.0 ✔ purrr 0.3.5
✔ tibble 3.1.8 ✔ dplyr 1.0.10
✔ tidyr 1.2.1 ✔ stringr 1.5.0
✔ readr 2.1.3 ✔ forcats 0.5.2 ── Conflicts ──────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
library(recommenderlab)
Loading required package: Matrix
Attaching package: ‘Matrix’
The following objects are masked from ‘package:tidyr’:
expand, pack, unpack
Loading required package: arules
Attaching package: ‘arules’
The following object is masked from ‘package:dplyr’:
recode
The following objects are masked from ‘package:base’:
abbreviate, write
Loading required package: proxy
Attaching package: ‘proxy’
The following object is masked from ‘package:Matrix’:
as.matrix
The following objects are masked from ‘package:stats’:
as.dist, dist
The following object is masked from ‘package:base’:
as.matrix
Loading required package: registry
library(gridExtra)
Attaching package: ‘gridExtra’
The following object is masked from ‘package:dplyr’:
combine
data(MovieLense)
Beim Einlesen des Datensatzes werden drei realRatingMatrix eingelesen: MovieLense, MovieLenseMeta und MovieLenseUser. Wir untersuchen nun zuerst MovieLense.
methods(class = class(MovieLense))
[1] [ [<- binarize calcPredictionAccuracy coerce colCounts
[7] colMeans colSds colSums denormalize dim dimnames
[13] dimnames<- dissimilarity evaluationScheme getData.frame getList getNormalize
[19] getRatingMatrix getRatings getTopNLists hasRating image normalize
[25] nratings Recommender removeKnownRatings rowCounts rowMeans rowSds
[31] rowSums sample show similarity
see '?methods' for accessing help and source code
Diese Übersicht zeigt uns, welche Methoden mit der realRatingMatrix in Kombination mit Recommenderlab möglich sind.
MovieLenseEDA <- as(MovieLense, "data.frame")
Um den EDA-Teil lösen zu können, haben wir die realRatingMatrix in einen data.frame umgewandelt.
head(MovieLenseEDA)
tail(MovieLenseEDA)
Um eine Idee der Daten zu erhalten, haben wir den Head und Tail des Dataframes ausgegeben. Es wird ersichtlich, dass für jede Zeile ein User, Item (Film) und das Rating erfasst sind.
summary(MovieLenseEDA)
user item rating
Length:99392 Length:99392 Min. :1.00
Class :character Class :character 1st Qu.:3.00
Mode :character Mode :character Median :4.00
Mean :3.53
3rd Qu.:4.00
Max. :5.00
Mit der Summary Funktion haben wir uns einen Überblick über die Zahlen im Datensatz erschaffen. Es sind jeweils 99’392 User und Items erfasst. Die Ratings reichen vom Bereich 1 bis 5 und der Mittelwert beträgt 3.53 (Median 4.0)
Aufgabe 1: Untersuche den vollständigen MovieLense Datensatz (d.h. vor Datenreduktion!) und beantworte folgende Fragen:
MovieLenseEDA %>%
group_by(item) %>%
summarise(Anzahl = n()) %>%
arrange(desc(Anzahl)) %>%
head(n=10)
Diese Tabelle zeigt uns die Top-10 der am meisten geschauten, resp. gerateten Filme. Es wird ersichtlich, dass Star Wars (1977, vermutlich “Krieg der Sterne”) 583 mal geschaut und geratet wurde.
# Full Join mit df_movies_rating und MovieLenseMeta
MovieLenseEDA_Joined <- full_join(MovieLenseEDA, MovieLenseMeta,
by = c("item" = "title")) %>%
select(-c("user", "item", "rating", "year", "url"))
# Aufsummieren der Genre Spalten
(colSums(MovieLenseEDA_Joined)) %>% sort(decreasing = TRUE)
Drama Comedy Action Thriller Romance Adventure Sci-Fi War Crime Children's Horror Mystery
39446 29778 25510 21808 19203 13688 12694 9398 8027 7143 5280 5237
Musical Animation Western Film-Noir Fantasy Documentary unknown
4954 3605 1854 1733 1352 758 10
Wir erkennen, dass das am häufigsten geschauten Genre “Drama” mit 39’446 Ratings ist. Auf dem zweiten Platz befindet sich “Comdey” und auf dem dritten “Action”. Am wenigsten häufig wurden “Documentary” und “unknown” geschaut.
# DataFrame join
MovieLenseEDA_Joined <- full_join(MovieLenseEDA, MovieLenseMeta,
by = c("item" = "title"))
Für diese Frage haben wir einen neuen Datensatz “MovieLenseEDA_Joined” erstellt. Er ergibt sich aus MovieLenseEDA und MovieLenseMeta. Folgend nun die Beantwortund der Frage.
MovieLenseEDA_Joined$rating <- as.factor(MovieLenseEDA_Joined$rating)
# Dataframe Uebersicht
MovieLenseEDA_Joined %>% group_by(rating) %>%
summarize(Anzahl = n())
# Visuelle Darstellung mittels Barplot
MovieLenseEDA_Joined %>% group_by(rating) %>%
summarize(Anzahl = n()) %>%
ggplot(aes(x = rating, y = Anzahl)) +
geom_bar(stat = "identity",
fill = "lightblue",
color = "black") +
labs(x = "Ratings",
y = "Anzahl",
title = "Verteilung der Kundenratings Gesamthaft",
subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA_Joined)[1]))
Wie wir in im Dataframe sowie im Barplot erkennen, werden am häufigsten die Ratings 3 und 4 vergeben. Rating von 1 und 2 kommen deutlich weniger vor, als möglicher Grund könnte sein, dass Filme die schlecht sind gar nicht bewertet wurden, da man sich nicht mehr weiter mit schlechten Filmen befassen möchte. Aus eigenen Erfahrungen können wir sagen, dass man eher mehr bereit ist einen Film zu bewerten, wenn diese auch wirklich gut ist. Das Rating 5 kommt am dritthäufigsten vor.
MovieLenseEDA_Joined$rating <- as.integer(MovieLenseEDA_Joined$rating)
MovieLenseEDA_Joined %>%
select(-c("item", "user", "year", "url")) %>%
pivot_longer(cols=c("unknown", "Action", "Adventure", "Animation", "Children's",
"Comedy", "Crime", "Documentary", "Drama", "Fantasy",
"Film-Noir", "Horror", "Musical", "Mystery", "Horror",
"Musical", "Mystery", "Romance", "Sci-Fi", "Thriller",
"War", "Western"),
names_to = "Genre", values_to = "is_genre") %>%
filter(is_genre == 1) %>%
ggplot(aes(x = rating)) +
geom_bar(fill = "lightblue", color = "black") +
labs(x = "Ratings",
y = "Anzahl",
title = "Verteilung der Kundenratings nach Genre",
subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA_Joined)[1])) +
facet_wrap(~Genre)
In der Visualisierung der Verteilung der Kundenratings pro Genre erkennen wir analog, wie bei der Verteilung der gesamthaften Kundenratings, dass die Rating 3 und 4 am meisten vergeben werden. Dieses Muster ist bei fast allen Genres erkennbar, einfach mit unterschiedlicher Intensität (Anzahl Ratings).
# Dataframe
MovieLenseEDA %>%
group_by(item) %>%
summarize(mean_rating_per_film = mean(rating),
n_rating_per_film = n()) %>%
arrange(n_rating_per_film)
# Visualisierung
MovieLenseEDA %>%
group_by(item) %>%
summarize(mean_rating_per_film = mean(rating)) %>%
ggplot(aes(x = mean_rating_per_film)) +
geom_histogram(color = "black", fill = "lightblue", binwidth = 0.1) +
labs(x = "Ratings",
y = "Anzahl",
title = "Verteilung der Mittleren Kundenratings pro Film",
subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA)[1]))
Wir erkennen im Plot die Verteilung durchschnittliche Rating pro Film. Auch hier ist erkennbar, dass die meisten Ratings zwischen 3 und 4 liegen. Einen Ausreisser gibt es beim Rating 1. Bei den natürlichen/ganzzähligen Zahlen erkennen wir ein überraschendes Muster: Die Anzahl erscheint jeweils höher als bei den umliegenden Ratings mit Kommastellen. Dies liegt daran, dass es Filme gibt die nur eine oder wenige Bewertungen bekommen haben (siehe ausgegebenes Datafarme).
MovieLenseEDA %>% filter(user == c(1:9)) %>%
ggplot(aes(x = user, y = rating)) +
geom_violin(color = "black", fill = "lightblue") +
labs(x = "User",
y = "Ratings",
title = "Streueung der Ratings von individuellen Kunden",
subtitle = "MovieLenseData, Kunden 1-9")
Im Violinenplot stellen wir die ersten 9 User und deren Rating Verteilungen dar. Wir erkennen im Plot, dass User 2 und 8 Filme sehr ähnliche bewerten. Beide bewerten Filme öfters mit einer 4 und eher weniger eine 3 und 5, aber nie 2 und 1. User 5 und 9 bewerten Filme hingegen im ganzen Bereich.
MovieLensenormalized <- normalize(MovieLense)
MovieLenseEDA_Normalized <- (as(MovieLensenormalized, "data.frame"))
MovieLenseEDA_Normalized %>% filter(user == c(1:9)) %>%
ggplot(aes(x = user, y = rating)) +
geom_violin(color = "black", fill = "lightblue") +
labs(x = "User",
y = "Normalisierte Ratings",
title = "Normalisierte Streueung der Ratings von individuellen Kunden",
subtitle = "MovieLenseData, Kunden 1 - 9")
Für die Normierung der Daten haben wir die Funktion von Recommenderlab verwendet. Der Mittelwert der Ratings pro User beträgt nun Null. Im Plot verschiebt sich nun nicht nur die y-Achse, sondern auch die Bandbreite. user 5 und 9, die auf den Rohdaten 1-5 bewertet haben, haben nun unterschiedliche Bandbreiten. Dies liegt daran, dass der Mittelwert der beiden User unterschiedlich ist.
image(x = MovieLense,
xlab = "Items",
ylab = "Users",
main = "Sparisty 943 x 1664 User-Item Matrix 943 x 1664")
image(MovieLense[1:50,1:50],
xlab = "Items",
ylab = "Users",
main = "Sparisty 50 x 50 User-Item Matrix")
# nratings(MovieLense) zaehlt die Anzahl vorhandenen Kombinationen von User und Items
(nratings(MovieLense) / (dim(MovieLense)[1] * dim(MovieLense)[2]) * 100)
[1] 6.334122
Für die Darstellung der Sparsity haben wir die image Funktion von Recommenderlab verwendet. Jede Zeile von MovieLense entspricht einem Benutzer und jede Spalte einem Film und für jede geschaute Kombination wird ein Pixel in Graustufen, je nach Rating, markiert. Im ersten Plot wird ersichtlich, dass die ersten User weniger Filme bewertet haben, denn oben rechts sind keine Punkte mehr ersichtlich. Auch ist auffällig, dass die ersten etwa 500 häufiger geschaut wurden, denn bis zu diesem Bereich sind am meisten Pixel eingefärbt. Um die Darstellung genau verstehen zu können, haben wir im zweiten Plot nur die ersten 50 User und Items dargestellt. Dort ist die hohe Sparsity gut erkennbar. Gesamthaft gibt es 943 x 1664 = 1’569’152 Kombinationen zwischen User und Film. Allerdings hat nicht jeder Nutzer jeden Film gesehen, aus diesem Grund ist es wichtig die sparsity der Matrix zu betrachten. In MovieLense Matrix fehlen ca. 94% der Kombinationen. Nur für 6.3% der möglichen Kombinationen sind Ratings vorhanden.
Aufgabe 2: Reduziere den MovieLense Datensatz auf rund 400 Kunden und 700 Filme, indem du Filme und Kunden mit sehr wenigen Ratings entfernst.
MovieLenseToCut <- as(MovieLense, "data.frame")
MovieLenseToCut
select_user_400 <- function(movie_df, start, end) {
selected_user <- movie_df %>%
group_by(user) %>%
summarize(Anzahl = n()) %>%
arrange(desc(Anzahl)) %>%
slice(start:end)
selected_user
}
MovieLense400User_1 <- select_user_400(MovieLenseToCut, 0, 400)
MovieLense400User_1
MovieLense400User_2 <- select_user_400(MovieLenseToCut, 200, 599)
MovieLense400User_2
Bei der Auswahl der 400 User haben wir direkt auch zwei Dataframes erstellt, da wir die MC zu zweit bearbeiten. Für Person 1 haben wir die 400 User mit den meisten Ratings ausgewählt und für Person 2 User 200 bis 600. Wir haben dieses Vorgehen gewählt um sicherzustellen, dass nur eine Teil der User in beiden Dataframes enthalten ist. Alternativ hätten wir von den Top 500 User zufällig 80% für Person 1 und 2 verwendet, dann hätte die Überlappung aber sehr hoch sein können, so ist es nur die Hälft.
select_item_700 <- function(movie_df, start, end) {
selected_item <- MovieLenseToCut %>%
group_by(item) %>%
summarise(Anzahl = n()) %>%
arrange(desc(Anzahl)) %>%
slice(start:end)
}
MovieLense700Items_1 <- select_item_700(MovieLenseToCut, 0, 700)
MovieLense700Items_1
MovieLense700Items_2 <- select_item_700(MovieLenseToCut, 150, 849)
MovieLense700Items_2
NA
Das gleiche Vorgehen haben wir bei den Filmen gewählt.
df_cutter <- function(movie_df, selected_user, selected_items) {
movie_df_cut <- movie_df %>%
filter(user %in% c(selected_user$user))
movie_df_cut <- movie_df_cut %>%
filter(item %in% c(selected_items$item))
movie_df_cut
}
MovieLenseCut_1 <- df_cutter(MovieLenseToCut, MovieLense400User_1, MovieLense700Items_1)
MovieLenseCut_1
MovieLenseCut_2 <- df_cutter(MovieLenseToCut, MovieLense400User_2, MovieLense700Items_2)
MovieLenseCut_2
Untersuche und dokumentiere die Eigenschaften des reduzierten Datensatzes und beschreibe den Effekt der Datenreduktion, d.h.
image(MovieLense,
xlab = "Items",
ylab = "Users",
main = "Vor Datenreduktion, User-Item Matrix 943 x 1664")
sparsity_text <- function(realrating_matrix) {
print(paste("Anzahl vorhandene User-Item Rating in", nratings(realrating_matrix) / (dim(realrating_matrix)[1] * dim(realrating_matrix)[2]) * 100, "%"))
print(paste("Sparsity der Matrix", 100 - (nratings(realrating_matrix) / (dim(realrating_matrix)[1] * dim(realrating_matrix)[2]) * 100), "%"))
}
sparsity_text(MovieLense)
[1] "Anzahl vorhandene User-Item Rating in 6.33412186964679 %"
[1] "Sparsity der Matrix 93.6658781303532 %"
Zur Repetition stellen wir nochmals die Sparsity als Bild dar und berechnen den Wert.
MovieLenseCompact_1 <- as(MovieLenseCut_1, "realRatingMatrix")
image(MovieLenseCompact_1,
xlab = "Items",
ylab = "Users",
main = "Nach Datenreduktion 1, User-Item Matrix 400 x 700")
sparsity_text(MovieLenseCompact_1)
[1] "Anzahl vorhandene User-Item Rating in 24.0810714285714 %"
[1] "Sparsity der Matrix 75.9189285714286 %"
Für den ersten Datensatz wird ersichtlich, dass die Ratings gegenüber dem ursprünglichen Datensatz gleichmässig verteilt sind. Vereinzelt sind für User (z.B. im Bereich 90-150) und Items (z.B Bereicht um 600) dunklere Bereiche erkennbar. In diesen dürften die Ratings höher und Sparsity geringer sein. Die Sparsity beträgt nun auch nur noch etwa 75% und für 25% der möglichen Kombinationen zwischen User und Item wurden Ratings angegeben.
Diese starke Änderung war aber zu erwarten, da wir die User und Items mit den meisten Ratings ausgewählt haben.
MovieLenseCompact_2 <- as(MovieLenseCut_2, "realRatingMatrix")
image(MovieLenseCompact_2,
xlab = "Items",
ylab = "Users",
main = "Nach Datenreduktion 2, User-Item Matrix 400 x 700")
sparsity_text(MovieLenseCompact_2)
[1] "Anzahl vorhandene User-Item Rating in 6.35142857142857 %"
[1] "Sparsity der Matrix 93.6485714285714 %"
Für den zweiten Datensatz wird ersichtlich, dass die Ratings gegenüber dem ursprünglichen Datensatz gleichmässig verteilt sind, gegenüber dem ersten Datensatz aber sichtbar weniger Ratings vorhanden sind. Dunklere Bereich, wie bei Datensatz1 sind kaum mehr zu erkennen. Die Sparsity beträgt liegt nun bei 93.6%, sie ist gegenüber dem ersten Datensatz also deutlich angestiegen, liegt aber bereits im Bereich des ursprünglichen Wertes. Dieser Anstieg war zu erwarten, da wir nicht mehr die User und Items mit den meisten Ratings ausgewählt haben, sondern z.B. bei den Usern bei Top 200 angefangen haben.
mean_rating_per_film_viz <- function(movie_df) {
movie_df %>%
group_by(item) %>%
summarize(mean_rating_per_film = mean(rating)) %>%
ggplot(aes(x = mean_rating_per_film)) +
geom_histogram(color = "black", fill = "lightblue", binwidth = 0.1) +
labs(x = "Ratings",
y = "Anzahl",
title = "Mittlere Kundenratings Verteilung",
subtitle = paste("Gesamte Anzahl Kundenratings:", dim(movie_df)[1])) +
geom_vline(xintercept = mean(movie_df$rating), color = "red", linetype = "dashed", size = 0.5)
}
# Vor reduktion
print(mean_rating_per_film_viz(MovieLenseEDA))
Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
Please use `linewidth` instead.
# nach 1. Redutkion
print(mean_rating_per_film_viz(MovieLenseCut_1))
# nach 2. Reduktion
print(mean_rating_per_film_viz(MovieLenseCut_2))
Die erste Visualisierung zeigt den bereits bekannten Plot mit den mittleren Kundenratings für den gesamten Datensatz. Plot 2 und 3 zeigt die selbe Auswertung für die beiden gekürzten Datensätze. In den Visualisierungen erkennen wir, dass der Mittelwert der Kundenrating für den ursprünglichen, sowie auch für die beiden reduzierten Datensätze, nicht grossartig ändert. Die Mittelwerte befinden sich bei allen im Bereich von 3.5. Was aber erkennbar wird, ist, dass bei der 1. Reduktion die hohe Anzahl Rating bei den natürlichen/ganzzahligen Zahlen weggefallen ist. Weiterhin sind bei allen Visualisierungen erkennbar, dass die meisten Rating im Bereich von 3 bis 4 liegen.
intersect_join <- inner_join(MovieLenseCut_1, MovieLenseCut_2, by = c("user", "item"))
intersect_join
union_join <- full_join(MovieLenseCut_1, MovieLenseCut_2, by = c("user", "item"))
union_join
paste("Eine Intersection over Union von", dim(intersect_join)[1] / dim(union_join)[1] * 100, "%, zwischen den beiden reduzierten Datensätzen")
[1] "Eine Intersection over Union von 15.5638434935919 %, zwischen den beiden reduzierten Datensätzen"
Zur Beantwortung dieser Frage haben wir einerseits einen Datensatz mit Daten, die in beiden Datensätzen vorhanden sind erstellt und diesen mit der gesamten Anzahl Daten verglichen. Es zeigt sich, dass es eine Überschneidung von 15.6% zwischen den beiden reduzierten Datensätzen gibt. Dieser eher tiefe Wert überrascht, weil z.B. 50% der User übereinstimmen. Aber aufgrund der hohen Sparsity ist die Überschneidung der Daten viel tiefer.
Aufgabe 3: Erzeuge einen IBCF Recommender und analysiere die Ähnlichkeitsmatrix des trainierten Modelles für den reduzierten Datensatz.
train_test_split <- function(movie_df, split = 0.8) {
n <- dim(movie_df)[1]
n_train <- round(n * split)
n_test <- n - n_train
training <- movie_df[1:n_train]
test <- movie_df[(n_train + 1):n]
return(list(training, test))
}
train_test_list_1 <- train_test_split(MovieLenseCompact_1)
training_1 <- train_test_list_1[[1]]
test_1 <- train_test_list_1[[2]]
training_1
320 x 700 rating matrix of class ‘realRatingMatrix’ with 53971 ratings.
test_1
80 x 700 rating matrix of class ‘realRatingMatrix’ with 13456 ratings.
train_test_list_2 <- train_test_split(MovieLenseCompact_2)
training_2 <- train_test_list_2[[1]]
test_2 <- train_test_list_2[[2]]
training_2
320 x 700 rating matrix of class ‘realRatingMatrix’ with 14368 ratings.
test_2
80 x 700 rating matrix of class ‘realRatingMatrix’ with 3416 ratings.
Beide reduzierten Datensätze wurden im Verhältnis 4:1, (4 Teile Training und 1 Teil Test) reduziert.
ribcf_1 <- Recommender(training_1, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_1
Recommender of type ‘IBCF’ for ‘realRatingMatrix’
learned using 320 users.
ribcf_2 <- Recommender(training_2, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_2
Recommender of type ‘IBCF’ for ‘realRatingMatrix’
learned using 320 users.
Es wurden jeweils für beide reduzierten Datensaetze ein IBCF Modell mit 30 Nachbarn und der Cosine Similarity mittels der von Recommenderlab zur Verfügung gestellten Methode trainiert. Die Auswertung bestätigt, dass das Training mittels 320 Usern, resp. 80% der ursprünglichen 400, durchgeführt wurde.
ribcf_sim_item_df <- function(ribcf) {
# model
ribcf_model <- getModel(ribcf)
# dataframe erstellen
ribcf_sim_df <- as.data.frame(colSums(ribcf_model$sim > 0))
# Item als neue Spalte hinzufuegen und Index entfernen
ribcf_sim_df_ <- cbind(item = rownames(ribcf_sim_df), ribcf_sim_df)
rownames(ribcf_sim_df_) <- NULL
# return df
ribcf_sim_df_
}
ribcf_sim_viz <- function(ribcf_sim_df_, n_reduc) {
ribcf_sim_df_ %>%
rename(Anzahl = 2) %>%
ggplot(aes(x = Anzahl)) +
geom_histogram(binwidth = 0.1) +
labs(title = "Verteilung der Ähnlichkeitsvergleiche",
x = "Anzahl Filme als Nachbar",
y = "Anzahl",
subtitle = paste("ribcf", n_reduc))
}
ribcf_sim_df_1 <- ribcf_sim_item_df(ribcf_1)
ribcf_sim_viz(ribcf_sim_df_1, 1)
ribcf_sim_df_2 <- ribcf_sim_item_df(ribcf_2)
ribcf_sim_viz(ribcf_sim_df_2, 2)
NA
NA
Im Histogramm erkennt man die Anzahl Filme die als Nachbar bei einem anderen Film auftauchen. Beide Plots sind deutlich unterschiedlich
top_10_item_sim <- function(ribcf_sim_df_, n_reduc) {
result <- ribcf_sim_df_ %>%
rename(Anzahl = 2) %>%
arrange(desc(Anzahl)) %>%
top_n(10)
print(result)
result %>%
ggplot(aes(x = Anzahl, y = item)) +
# arrange desc
geom_col(alpha = 0.5, color = "black", fill = "limegreen") +
labs(title = "Top 10 Filme die am häufigsten in der Nachbarschaft andere Filme auftauchen",
x = "Anzahl Film als Nachbar",
y = "Filme",
subtitle = paste("ribcf", n_reduc))
}
top_10_item_sim(ribcf_sim_df_1, 1)
Selecting by Anzahl
top_10_item_sim(ribcf_sim_df_2, 2)
Selecting by Anzahl
Für jeden der beiden Datensätze haben wir einen Dataframe und Plot mit den Filmen, die am häufigsten in der Cosine-Ähnlichkeitsmatrix auftauchen, erstellt. Bei den top 10 Filmen sind keine Gemeinsamkeiten ersichtlich. Die Anzahl der Vorkommen ist aber ähnlich, der höchste Wert ist zwischen 150 und 160 und die Nummer 10 liegt bei 120 Vorkommen.
Aufgabe 4 (DIY): Implementiere eine Funktion zur effizienten Berechnung von sparsen Ähnlichkeitsmatrizen für IBCF RS und analysiere die Resultate für 100 zufällig gewählte Filme.
die Cosine Similarity und (b) für binäre Ratings effizient die Jaccard Similarity zu berechnen,
number_user <- 100
number_item <- 100
Diese Variablen haben wir für die Entwicklung der Funktionen verwendet. Wir konnte damit einfach kleinere, z.B. 5, Datensätze slicen.
get_cossim_4 <- function(RatingMatrix, n_user, n_item){
sliced_matrix <- getRatingMatrix(RatingMatrix[1:n_user, 1:n_item])
sliced_matrix_t <- t(sliced_matrix)
temp_sim <- sliced_matrix_t / sqrt(rowSums(sliced_matrix_t ** 2))
cossim_matrix <- temp_sim %*% t(temp_sim)
cossim_matrix
}
result_cossim_4 <- get_cossim_4(MovieLense, number_user, number_item)
result_cossim_4[1:20,1:20]
20 x 20 sparse Matrix of class "dgCMatrix"
[[ suppressing 20 column names ‘Toy Story (1995)’, ‘GoldenEye (1995)’, ‘Four Rooms (1995)’ ... ]]
Toy Story (1995) 1.0000000 0.3786054 0.3557149 0.4085792 0.35406521 0.2106625 0.6507823 0.5128509 0.4809693
GoldenEye (1995) 0.3786054 1.0000000 0.1595558 0.4058678 0.33981928 0.1078328 0.2498391 0.2921164 0.2701317
Four Rooms (1995) 0.3557149 0.1595558 1.0000000 0.3989039 0.22857516 0.2263010 0.3581228 0.2310704 0.2649610
Get Shorty (1995) 0.4085792 0.4058678 0.3989039 1.0000000 0.26745994 0.1328422 0.4245295 0.5445979 0.4781120
Copycat (1995) 0.3540652 0.3398193 0.2285752 0.2674599 1.00000000 0.1313064 0.3322003 0.2039381 0.4163740
Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.2106625 0.1078328 0.2263010 0.1328422 0.13130643 1.0000000 0.2130495 0.1805984 0.2092867
Twelve Monkeys (1995) 0.6507823 0.2498391 0.3581228 0.4245295 0.33220032 0.2130495 1.0000000 0.5179884 0.5991567
Babe (1995) 0.5128509 0.2921164 0.2310704 0.5445979 0.20393810 0.1805984 0.5179884 1.0000000 0.6064674
Dead Man Walking (1995) 0.4809693 0.2701317 0.2649610 0.4781120 0.41637401 0.2092867 0.5991567 0.6064674 1.0000000
Richard III (1995) 0.2412952 0.1873510 0.3780578 0.2820925 0.07604487 0.4311379 0.2699059 0.3242348 0.3275021
Seven (Se7en) (1995) 0.4553382 0.1632439 0.3843138 0.5195206 0.36995125 0.1093345 0.5694625 0.5399670 0.5360525
Usual Suspects, The (1995) 0.4651021 0.3486586 0.3794973 0.6074053 0.39453741 0.2776088 0.5844860 0.5715472 0.6633322
Mighty Aphrodite (1995) 0.5220124 0.2496832 0.3871603 0.3777443 0.19202253 0.3006045 0.5160271 0.4357768 0.4985081
Postino, Il (1994) 0.4588155 0.1724141 0.4344255 0.2698077 0.15320397 0.4191717 0.3159025 0.4495279 0.4480904
Mr. Holland's Opus (1995) 0.6120818 0.2968567 0.3117847 0.3590970 0.39631951 0.1791067 0.5034813 0.3576072 0.5884584
French Twist (Gazon maudit) (1995) 0.2202742 0.2062550 0.3329636 0.2625611 0.25115377 0.3187884 0.1833778 0.0345436 0.2486767
From Dusk Till Dawn (1996) 0.3199297 0.3785939 0.2558409 0.3633585 0.32163376 0.2531139 0.2413614 0.2963905 0.3417637
White Balloon, The (1995) 0.1396962 0.1479453 0.4776651 0.2126344 0.18015094 0.3658636 0.2192261 0.1176950 0.3480472
Antonia's Line (1995) 0.2946435 0.1047364 0.1690792 0.1032222 0.12753608 0.4662172 0.3078112 0.2350530 0.2710362
Angels and Insects (1995) 0.1891240 0.1290770 0.4427924 0.1855159 0.15717527 0.4488792 0.1593891 0.2594140 0.3226374
Toy Story (1995) 0.24129522 0.45533821 0.4651021 0.5220124 0.4588155 0.6120818 0.2202742 0.3199297 0.1396962
GoldenEye (1995) 0.18735098 0.16324390 0.3486586 0.2496832 0.1724141 0.2968567 0.2062550 0.3785939 0.1479453
Four Rooms (1995) 0.37805783 0.38431384 0.3794973 0.3871603 0.4344255 0.3117847 0.3329636 0.2558409 0.4776651
Get Shorty (1995) 0.28209250 0.51952065 0.6074053 0.3777443 0.2698077 0.3590970 0.2625611 0.3633585 0.2126344
Copycat (1995) 0.07604487 0.36995125 0.3945374 0.1920225 0.1532040 0.3963195 0.2511538 0.3216338 0.1801509
Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.43113793 0.10933445 0.2776088 0.3006045 0.4191717 0.1791067 0.3187884 0.2531139 0.3658636
Twelve Monkeys (1995) 0.26990593 0.56946246 0.5844860 0.5160271 0.3159025 0.5034813 0.1833778 0.2413614 0.2192261
Babe (1995) 0.32423475 0.53996700 0.5715472 0.4357768 0.4495279 0.3576072 0.0345436 0.2963905 0.1176950
Dead Man Walking (1995) 0.32750209 0.53605254 0.6633322 0.4985081 0.4480904 0.5884584 0.2486767 0.3417637 0.3480472
Richard III (1995) 1.00000000 0.35313083 0.3688357 0.3724946 0.4171123 0.1504695 0.1846233 0.3940552 0.4745374
Seven (Se7en) (1995) 0.35313083 1.00000000 0.6427527 0.2562351 0.2316937 0.3159148 0.2091273 0.3399173 0.2884724
Usual Suspects, The (1995) 0.36883567 0.64275270 1.0000000 0.4417965 0.3831814 0.4257209 0.2811128 0.3440000 0.3920784
Mighty Aphrodite (1995) 0.37249460 0.25623511 0.4417965 1.0000000 0.5845588 0.4709003 0.2874876 0.1293548 0.3692327
Postino, Il (1994) 0.41711226 0.23169366 0.3831814 0.5845588 1.0000000 0.4880400 0.2066398 0.2381653 0.5039526
Mr. Holland's Opus (1995) 0.15046955 0.31591479 0.4257209 0.4709003 0.4880400 1.0000000 0.1586031 0.1868622 0.3185419
French Twist (Gazon maudit) (1995) 0.18462325 0.20912731 0.2811128 0.2874876 0.2066398 0.1586031 1.0000000 0.2342606 0.4373740
From Dusk Till Dawn (1996) 0.39405520 0.33991729 0.3440000 0.1293548 0.2381653 0.1868622 0.2342606 1.0000000 0.3360672
White Balloon, The (1995) 0.47453738 0.28847237 0.3920784 0.3692327 0.5039526 0.3185419 0.4373740 0.3360672 1.0000000
Antonia's Line (1995) 0.38125745 0.08985732 0.3045318 0.5365988 0.4952783 0.3028259 0.3096346 0.2141239 0.4886175
Angels and Insects (1995) 0.42364525 0.18246935 0.2980934 0.3282205 0.5172714 0.2431769 0.3815932 0.3420744 0.5303215
Toy Story (1995) 0.29464348 0.1891240
GoldenEye (1995) 0.10473645 0.1290770
Four Rooms (1995) 0.16907917 0.4427924
Get Shorty (1995) 0.10322223 0.1855159
Copycat (1995) 0.12753608 0.1571753
Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.46621721 0.4488792
Twelve Monkeys (1995) 0.30781124 0.1593891
Babe (1995) 0.23505300 0.2594140
Dead Man Walking (1995) 0.27103623 0.3226374
Richard III (1995) 0.38125745 0.4236452
Seven (Se7en) (1995) 0.08985732 0.1824693
Usual Suspects, The (1995) 0.30453181 0.2980934
Mighty Aphrodite (1995) 0.53659876 0.3282205
Postino, Il (1994) 0.49527834 0.5172714
Mr. Holland's Opus (1995) 0.30282587 0.2431769
French Twist (Gazon maudit) (1995) 0.30963462 0.3815932
From Dusk Till Dawn (1996) 0.21412393 0.3420744
White Balloon, The (1995) 0.48861751 0.5303215
Antonia's Line (1995) 1.00000000 0.3100373
Angels and Insects (1995) 0.31003735 1.0000000
Mit der erstellten Funktion haben wir für den gesamten MovieLense Datensatz die Cosine Similarity Matrix berechnet. Um das Resultat lesbar darzustellen, zeigen wir hier nur die ersten fünf Item. Bei der Analyse der ersten 20 Items wurde ersichtlich, dass die Werte zwischen 0 und 1 liegen. Negative Similarities sind nicht ersichtlich. Wie mit dir besprochen und hergeleitet, ist das aber verständlich, da aufgrund der nicht-negativen Ratings der maximale Winkel 90° beträgt. Hätten wir mit normierten Ratings gearbeitet, wären auch negative Werte aufgetreten.
get_jaccardsim_4 <- function(RatingMatrix, n_user, n_item){
sliced_matrix_bin <- as(binarize(RatingMatrix[1:n_user, 1:n_item], minRating=4), "matrix")
sliced_matrix_bin_t <- t(sliced_matrix_bin)
matrix_corssprod <- tcrossprod(sliced_matrix_bin_t)
im <- which(matrix_corssprod > 0, arr.ind=TRUE)
b <- rowSums(sliced_matrix_bin_t)
Aim <- matrix_corssprod[im]
J = sparseMatrix(
i = im[,1],
j = im[,2],
x = Aim / (b[im[,1]] + b[im[,2]] - Aim),
dims = dim(matrix_corssprod)
)
J <- data.matrix(J)
J
}
get_jaccardsim_4(MovieLense, number_user, number_item)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
[1,] 1.00000000 0.05128205 0.05128205 0.13043478 0.10526316 0.07317073 0.38983051 0.31914894 0.24561404 0.04651163 0.22727273 0.25000000 0.17391304
[2,] 0.05128205 1.00000000 0.00000000 0.06250000 0.00000000 0.00000000 0.02173913 0.03846154 0.02857143 0.00000000 0.00000000 0.03448276 0.00000000
[3,] 0.05128205 0.00000000 1.00000000 0.06250000 0.00000000 0.12500000 0.06818182 0.00000000 0.05882353 0.11111111 0.05555556 0.07142857 0.11764706
[4,] 0.13043478 0.06250000 0.06250000 1.00000000 0.12500000 0.00000000 0.20833333 0.31034483 0.23684211 0.10526316 0.30434783 0.32258065 0.15384615
[5,] 0.10526316 0.00000000 0.00000000 0.12500000 1.00000000 0.00000000 0.06666667 0.07692308 0.12121212 0.00000000 0.11111111 0.10714286 0.05263158
[6,] 0.07317073 0.00000000 0.12500000 0.00000000 0.00000000 1.00000000 0.08695652 0.07142857 0.08333333 0.18181818 0.04761905 0.10000000 0.10000000
[7,] 0.38983051 0.02173913 0.06818182 0.20833333 0.06666667 0.08695652 1.00000000 0.28301887 0.32758621 0.08510638 0.27659574 0.39215686 0.20000000
[8,] 0.31914894 0.03846154 0.00000000 0.31034483 0.07692308 0.07142857 0.28301887 1.00000000 0.39024390 0.14814815 0.29032258 0.34210526 0.17647059
[9,] 0.24561404 0.02857143 0.05882353 0.23684211 0.12121212 0.08333333 0.32758621 0.39024390 1.00000000 0.14285714 0.28947368 0.46341463 0.19512195
[10,] 0.04651163 0.00000000 0.11111111 0.10526316 0.00000000 0.18181818 0.08510638 0.14814815 0.14285714 1.00000000 0.15000000 0.13333333 0.09523810
[,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26]
[1,] 0.19565217 0.27450980 0.05263158 0.05000000 0.02564103 0.10000000 0.02500000 0.00000000 0.23529412 0.22222222 0.06976744 0.24489796 0.05128205
[2,] 0.00000000 0.07142857 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.07692308 0.00000000 0.00000000 0.04000000 0.00000000
[3,] 0.11111111 0.07142857 0.25000000 0.00000000 0.66666667 0.12500000 0.20000000 0.00000000 0.07692308 0.11111111 0.10000000 0.13043478 0.00000000
[4,] 0.10714286 0.10810811 0.06666667 0.05882353 0.06666667 0.00000000 0.06250000 0.07142857 0.30000000 0.14814815 0.22222222 0.08823529 0.06250000
[5,] 0.00000000 0.10714286 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.03571429 0.05000000 0.00000000 0.08000000 0.16666667
[6,] 0.15000000 0.06451613 0.14285714 0.11111111 0.14285714 0.20000000 0.28571429 0.00000000 0.10714286 0.21052632 0.00000000 0.07407407 0.28571429
[7,] 0.10909091 0.24561404 0.04545455 0.02127660 0.04545455 0.11111111 0.04444444 0.00000000 0.27777778 0.19607843 0.10638298 0.24074074 0.02173913
[8,] 0.28125000 0.13333333 0.00000000 0.03703704 0.00000000 0.07142857 0.08000000 0.00000000 0.28947368 0.24242424 0.10344828 0.14634146 0.12500000
[9,] 0.21951220 0.33333333 0.06060606 0.05714286 0.06060606 0.08333333 0.09090909 0.00000000 0.28888889 0.28205128 0.07894737 0.21739130 0.09090909
[10,] 0.20000000 0.03030303 0.00000000 0.10000000 0.12500000 0.08333333 0.11111111 0.00000000 0.14285714 0.14285714 0.07142857 0.11111111 0.11111111
[,27] [,28] [,29] [,30] [,31] [,32] [,33] [,34] [,35] [,36] [,37] [,38] [,39] [,40]
[1,] 0.00000000 0.32653061 0.02631579 0.00000000 0.18604651 0.13636364 0.05000000 0 0.02631579 0 0 0.02564103 0.05000000 0.05263158
[2,] 0.16666667 0.07142857 0.00000000 0.00000000 0.06666667 0.00000000 0.00000000 0 0.00000000 0 0 0.66666667 0.00000000 0.00000000
[3,] 0.00000000 0.07142857 0.00000000 0.20000000 0.00000000 0.15384615 0.16666667 0 0.00000000 0 0 0.00000000 0.40000000 0.00000000
[4,] 0.12500000 0.20588235 0.00000000 0.06250000 0.17391304 0.23809524 0.12500000 0 0.00000000 0 0 0.06666667 0.20000000 0.06666667
[5,] 0.00000000 0.06896552 0.00000000 0.00000000 0.13333333 0.00000000 0.00000000 0 0.00000000 0 0 0.00000000 0.00000000 0.00000000
[6,] 0.00000000 0.03125000 0.00000000 0.12500000 0.05555556 0.05882353 0.25000000 0 0.00000000 0 0 0.00000000 0.11111111 0.00000000
[7,] 0.06666667 0.24561404 0.00000000 0.04444444 0.21276596 0.19148936 0.04347826 0 0.00000000 0 0 0.02222222 0.09090909 0.02222222
[8,] 0.12000000 0.27500000 0.00000000 0.03846154 0.23333333 0.16129032 0.07692308 0 0.00000000 0 0 0.04000000 0.07692308 0.00000000
[9,] 0.08823529 0.25000000 0.00000000 0.09090909 0.17948718 0.21621622 0.08823529 0 0.00000000 0 0 0.02941176 0.12121212 0.02941176
[10,] 0.22222222 0.13333333 0.00000000 0.25000000 0.17647059 0.11764706 0.10000000 0 0.00000000 0 0 0.00000000 0.22222222 0.00000000
[,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48] [,49] [,50] [,51] [,52] [,53]
[1,] 0.00000000 0.20454545 0.05263158 0.05000000 0.12500000 0.05263158 0.06666667 0.20930233 0.07500000 0.43283582 0.12500000 0.14285714 0.04878049
[2,] 0.00000000 0.00000000 0.25000000 0.00000000 0.00000000 0.00000000 0.00000000 0.13333333 0.14285714 0.03389831 0.00000000 0.00000000 0.00000000
[3,] 0.00000000 0.20000000 0.25000000 0.40000000 0.25000000 0.25000000 0.18181818 0.13333333 0.00000000 0.03389831 0.25000000 0.18181818 0.14285714
[4,] 0.00000000 0.16000000 0.00000000 0.12500000 0.10526316 0.06666667 0.26315789 0.21739130 0.26666667 0.20000000 0.16666667 0.20000000 0.18750000
[5,] 0.00000000 0.05555556 0.00000000 0.00000000 0.10000000 0.20000000 0.07692308 0.12500000 0.12500000 0.05084746 0.22222222 0.07692308 0.00000000
[6,] 0.00000000 0.10526316 0.14285714 0.11111111 0.18181818 0.14285714 0.06666667 0.11111111 0.00000000 0.06666667 0.08333333 0.23076923 0.00000000
[7,] 0.02272727 0.22916667 0.02222222 0.09090909 0.08510638 0.04545455 0.17391304 0.16000000 0.08888889 0.43661972 0.10869565 0.12500000 0.11363636
[8,] 0.04166667 0.18181818 0.00000000 0.03703704 0.10714286 0.04000000 0.17241379 0.22580645 0.16000000 0.30158730 0.14814815 0.21428571 0.07407407
[9,] 0.03030303 0.20000000 0.02941176 0.08823529 0.17647059 0.06060606 0.22857143 0.27027027 0.08571429 0.35820896 0.17647059 0.19444444 0.11764706
[10,] 0.00000000 0.10000000 0.00000000 0.22222222 0.07692308 0.00000000 0.13333333 0.10526316 0.00000000 0.10169492 0.07692308 0.21428571 0.20000000
[,54] [,55] [,56] [,57] [,58] [,59] [,60] [,61] [,62] [,63] [,64] [,65] [,66]
[1,] 0.05128205 0.11363636 0.32758621 0.04878049 0.16666667 0.11111111 0.04651163 0.09523810 0.07142857 0.05128205 0.35087719 0.09523810 0.12820513
[2,] 0.20000000 0.07692308 0.02439024 0.00000000 0.07692308 0.00000000 0.00000000 0.00000000 0.11111111 1.00000000 0.07692308 0.00000000 0.50000000
[3,] 0.20000000 0.16666667 0.05000000 0.14285714 0.16666667 0.15384615 0.25000000 0.22222222 0.00000000 0.00000000 0.05000000 0.22222222 0.12500000
[4,] 0.13333333 0.25000000 0.26190476 0.00000000 0.25000000 0.18181818 0.10526316 0.15789474 0.16666667 0.06250000 0.26190476 0.15789474 0.17647059
[5,] 0.00000000 0.07142857 0.07500000 0.00000000 0.15384615 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.10256410 0.09090909 0.11111111
[6,] 0.00000000 0.06250000 0.09756098 0.37500000 0.13333333 0.28571429 0.44444444 0.27272727 0.00000000 0.00000000 0.09756098 0.27272727 0.09090909
[7,] 0.04444444 0.22222222 0.45614035 0.04255319 0.10000000 0.16666667 0.08510638 0.13043478 0.08510638 0.02173913 0.40677966 0.10638298 0.08695652
[8,] 0.03846154 0.20689655 0.40000000 0.11538462 0.20689655 0.20000000 0.10714286 0.14285714 0.10714286 0.03846154 0.43181818 0.18518519 0.11111111
[9,] 0.05882353 0.22222222 0.46938776 0.11764706 0.22222222 0.21621622 0.14285714 0.17142857 0.02564103 0.02857143 0.44000000 0.17142857 0.11428571
[10,] 0.11111111 0.05882353 0.12195122 0.20000000 0.12500000 0.11764706 0.16666667 0.07142857 0.00000000 0.00000000 0.12195122 0.15384615 0.00000000
[,67] [,68] [,69] [,70] [,71] [,72] [,73] [,74] [,75] [,76] [,77] [,78] [,79]
[1,] 0.02564103 0.07317073 0.35416667 0.30434783 0.25000000 0.05000000 0.12195122 0 0.02631579 0.07692308 0.11904762 0.02631579 0.38181818
[2,] 0.25000000 0.00000000 0.07142857 0.08695652 0.05263158 0.00000000 0.10000000 0 0.00000000 0.00000000 0.20000000 0.00000000 0.07894737
[3,] 0.00000000 0.12500000 0.03448276 0.00000000 0.00000000 0.16666667 0.10000000 0 0.33333333 0.16666667 0.20000000 0.00000000 0.07894737
[4,] 0.06666667 0.17647059 0.32258065 0.16129032 0.34782609 0.12500000 0.10000000 0 0.00000000 0.20000000 0.09523810 0.00000000 0.20930233
[5,] 0.00000000 0.00000000 0.14814815 0.08333333 0.10526316 0.00000000 0.09090909 0 0.00000000 0.00000000 0.08333333 0.00000000 0.07692308
[6,] 0.00000000 0.09090909 0.00000000 0.12000000 0.04545455 0.11111111 0.00000000 0 0.16666667 0.11111111 0.07142857 0.00000000 0.07317073
[7,] 0.02222222 0.11111111 0.29090909 0.24528302 0.17307692 0.06666667 0.10638298 0 0.02272727 0.09090909 0.10416667 0.00000000 0.41379310
[8,] 0.04000000 0.11111111 0.30769231 0.35294118 0.46428571 0.12000000 0.10344828 0 0.00000000 0.12000000 0.06451613 0.00000000 0.37777778
[9,] 0.02941176 0.08333333 0.30434783 0.34146341 0.28205128 0.08823529 0.13888889 0 0.03030303 0.12121212 0.16666667 0.00000000 0.29090909
[10,] 0.00000000 0.08333333 0.13333333 0.11538462 0.09090909 0.22222222 0.07142857 0 0.00000000 0.00000000 0.14285714 0.00000000 0.09756098
[,80] [,81] [,82] [,83] [,84] [,85] [,86] [,87] [,88] [,89] [,90] [,91] [,92]
[1,] 0.02439024 0.11627907 0.26086957 0.15909091 0.05263158 0.02564103 0.13953488 0.19565217 0.18604651 0.20370370 0.02631579 0.17073171 0.09302326
[2,] 0.16666667 0.00000000 0.15000000 0.06666667 0.00000000 0.00000000 0.00000000 0.11111111 0.23076923 0.03448276 0.00000000 0.00000000 0.00000000
[3,] 0.16666667 0.18181818 0.09523810 0.06666667 0.25000000 0.00000000 0.07692308 0.11111111 0.06666667 0.07142857 0.33333333 0.18181818 0.09090909
[4,] 0.20000000 0.20000000 0.25925926 0.12500000 0.00000000 0.14285714 0.13636364 0.14814815 0.17391304 0.20588235 0.00000000 0.14285714 0.35294118
[5,] 0.00000000 0.07692308 0.09090909 0.00000000 0.00000000 0.00000000 0.07142857 0.10526316 0.06250000 0.06896552 0.00000000 0.00000000 0.08333333
[6,] 0.11111111 0.06666667 0.04000000 0.11764706 0.14285714 0.00000000 0.21428571 0.04545455 0.05555556 0.10000000 0.16666667 0.06666667 0.07142857
[7,] 0.06666667 0.20000000 0.23076923 0.11764706 0.02222222 0.02222222 0.12244898 0.17307692 0.11764706 0.29090909 0.02272727 0.22727273 0.20454545
[8,] 0.07692308 0.17241379 0.15789474 0.32142857 0.00000000 0.00000000 0.29629630 0.20588235 0.15625000 0.27500000 0.00000000 0.21428571 0.17857143
[9,] 0.08823529 0.26470588 0.17777778 0.17948718 0.02941176 0.02941176 0.22222222 0.25000000 0.12195122 0.22448980 0.03030303 0.13157895 0.16666667
[10,] 0.10000000 0.21428571 0.03846154 0.17647059 0.00000000 0.00000000 0.20000000 0.14285714 0.00000000 0.13333333 0.00000000 0.13333333 0.14285714
[,93] [,94] [,95] [,96] [,97] [,98] [,99] [,100]
[1,] 0.09090909 0.10256410 0.30232558 0.26923077 0.18750000 0.40350877 0.23255814 0.43548387
[2,] 0.00000000 0.33333333 0.10526316 0.06896552 0.10000000 0.02272727 0.05882353 0.01886792
[3,] 0.08333333 0.00000000 0.05000000 0.06896552 0.04761905 0.07142857 0.05882353 0.03846154
[4,] 0.20000000 0.05555556 0.10344828 0.27272727 0.26923077 0.24444444 0.20833333 0.20370370
[5,] 0.07692308 0.00000000 0.10000000 0.10344828 0.09523810 0.06976744 0.05555556 0.07843137
[6,] 0.14285714 0.00000000 0.09090909 0.09677419 0.08695652 0.09090909 0.05000000 0.09615385
[7,] 0.20000000 0.06521739 0.19230769 0.35849057 0.14545455 0.45762712 0.15686275 0.53225806
[8,] 0.09677419 0.07407407 0.23529412 0.30000000 0.34375000 0.37500000 0.30000000 0.33928571
[9,] 0.13157895 0.02702703 0.18604651 0.27083333 0.30000000 0.38888889 0.20000000 0.44827586
[10,] 0.06250000 0.00000000 0.08695652 0.12903226 0.13043478 0.11363636 0.15789474 0.11538462
[ reached getOption("max.print") -- omitted 90 rows ]
Bei der Jaccard Similarity sind wiederum nur positive Werte ersichtlich. Eine Auswertung dieser geplotteten Werte ergibt, dass sehr wenige Werte über 0.3 liegen. Die Ähnlichkeit dieser ersten 10 Filme gegenüber den ersten 100 anderen Items ist also eher gering.
Ähnlichkeitsmatrix für ordinale Ratings mit der via recommenderlab und einem anderen R-Paket erzeugten Ähnlichkeitsmatrix,
#recom_simcosin_4 <- as.matrix(similarity(normalize(MovieLense[1:number_user, 1:number_item]), which = "items", method = "cosine"))
recom_simcosin_4 <- as.matrix(similarity(MovieLense[1:number_user, 1:number_item], which = "items", method = "cosine"))
recom_simcosin_4[1:5,1:5]
Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995) Copycat (1995)
Toy Story (1995) NA 0.9821980 0.9308431 0.9664688 0.9730499
GoldenEye (1995) 0.9821980 NA 0.9455211 0.9598695 0.9629100
Four Rooms (1995) 0.9308431 0.9455211 NA 0.9687050 0.9472136
Get Shorty (1995) 0.9664688 0.9598695 0.9687050 NA 0.9368489
Copycat (1995) 0.9730499 0.9629100 0.9472136 0.9368489 NA
result_cossim_4_scaled <- 1 / 2 * (result_cossim_4 + 1)
result_cossim_4_scaled[1:5,1:5]
5 x 5 Matrix of class "dgeMatrix"
Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995) Copycat (1995)
Toy Story (1995) 1.0000000 0.6893027 0.6778574 0.7042896 0.6770326
GoldenEye (1995) 0.6893027 1.0000000 0.5797779 0.7029339 0.6699096
Four Rooms (1995) 0.6778574 0.5797779 1.0000000 0.6994520 0.6142876
Get Shorty (1995) 0.7042896 0.7029339 0.6994520 1.0000000 0.6337300
Copycat (1995) 0.6770326 0.6699096 0.6142876 0.6337300 1.0000000
library(lsa)
rec_simMat <- similarity(MovieLenseCompact_1[,1:5], which = "items")
rec_simMat
101 Dalmatians (1996) 12 Angry Men (1957) 187 (1997) 2 Days in the Valley (1996)
12 Angry Men (1957) 0.9491014
187 (1997) 0.9377585 0.9951661
2 Days in the Valley (1996) 0.9424520 0.9908561 0.9728694
20,000 Leagues Under the Sea (1954) 0.9636541 0.9846314 0.9824506 0.9745629
# simMat_lsa <- cosine(DfforSimMatrix, y = NULL)
Aufgabe 5: Vergleiche und diskutiere Top-N Empfehlungen von IBCF und UBCF Modellen mit 30 Nachbarn und Cosine Similarity für den reduzierten Datensatz. ## 5.1 Berechne Top-15 Empfehlungen für Testkunden mit IBCF und UBCF ### 5.1.1 ribcf & rubcf Modell trainieren
ribcf_1 <- Recommender(training_1, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_1
Recommender of type ‘IBCF’ for ‘realRatingMatrix’
learned using 320 users.
rubcf_1 <- Recommender(training_1, "UBCF", param=list(nn= 30, method = "cosine"))
rubcf_1
Recommender of type ‘UBCF’ for ‘realRatingMatrix’
learned using 320 users.
ribcf_2 <- Recommender(training_2, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_2
Recommender of type ‘IBCF’ for ‘realRatingMatrix’
learned using 320 users.
rubcf_2 <- Recommender(training_2, "UBCF", param=list(nn= 30, method = "cosine"))
rubcf_2
Recommender of type ‘UBCF’ for ‘realRatingMatrix’
learned using 320 users.
Es wurden für beide reduzierten Datensätze jeweils ein ibcf und ubcf Recommender erstellt.
ribcftopNList_1 <- predict(ribcf_1, test_1, n=15)
ribcftopNList_1
Recommendations as ‘topNList’ with n = 15 for 80 users.
rubcftopNList_1 <- predict(rubcf_1, test_1, n=15)
rubcftopNList_1
Recommendations as ‘topNList’ with n = 15 for 80 users.
ribcftopNList_2 <- predict(ribcf_2, test_2, n=15)
ribcftopNList_2
Recommendations as ‘topNList’ with n = 15 for 80 users.
rubcftopNList_2 <- predict(rubcf_2, test_2, n=15)
rubcftopNList_2
Recommendations as ‘topNList’ with n = 15 for 80 users.
Nun wurden für beide Datensätze Predictions mit n = 15 und für 80 User berechnet.
# ausgabe von einem output
as(ribcftopNList_1, "list")[1:5]
$`0`
[1] "Strictly Ballroom (1992)" "Like Water For Chocolate (Como agua para chocolate) (1992)"
[3] "Casablanca (1942)" "In the Company of Men (1997)"
[5] "Love Bug, The (1969)" "My Left Foot (1989)"
[7] "African Queen, The (1951)" "Fantasia (1940)"
[9] "Fear (1996)" "Sphere (1998)"
[11] "Dial M for Murder (1954)" "Dead Man Walking (1995)"
[13] "Citizen Kane (1941)" "Smoke (1995)"
[15] "What's Eating Gilbert Grape (1993)"
$`1`
[1] "2 Days in the Valley (1996)" "Adventures of Robin Hood, The (1938)" "Alice in Wonderland (1951)"
[4] "American in Paris, An (1951)" "Being There (1979)" "Bringing Up Baby (1938)"
[7] "Cinema Paradiso (1988)" "Crash (1996)" "Dead Man Walking (1995)"
[10] "Ed Wood (1994)" "Grand Day Out, A (1992)" "Hunt for Red October, The (1990)"
[13] "Jackie Chan's First Strike (1996)" "Jungle Book, The (1994)" "Madness of King George, The (1994)"
$`2`
[1] "Time to Kill, A (1996)" "City Hall (1996)" "City of Lost Children, The (1995)" "In the Company of Men (1997)"
[5] "Independence Day (ID4) (1996)" "M*A*S*H (1970)" "Forrest Gump (1994)" "Braveheart (1995)"
[9] "Dave (1993)" "Dead Poets Society (1989)" "Mr. Holland's Opus (1995)" "Cool Hand Luke (1967)"
[13] "In the Line of Fire (1993)" "Ghost (1990)" "Blade Runner (1982)"
$`3`
[1] "Bob Roberts (1992)" "Clerks (1994)" "Cool Hand Luke (1967)"
[4] "Gandhi (1982)" "His Girl Friday (1940)" "Ice Storm, The (1997)"
[7] "Pink Floyd - The Wall (1982)" "Postino, Il (1994)" "Rebel Without a Cause (1955)"
[10] "Willy Wonka and the Chocolate Factory (1971)" "Shine (1996)" "Seven (Se7en) (1995)"
[13] "Grosse Pointe Blank (1997)" "Three Colors: Red (1994)" "Boot, Das (1981)"
$`4`
[1] "Monty Python's Life of Brian (1979)" "Henry V (1989)" "As Good As It Gets (1997)"
[4] "In the Company of Men (1997)" "Junior (1994)" "Renaissance Man (1994)"
[7] "Cinema Paradiso (1988)" "Dumbo (1941)" "White Squall (1996)"
[10] "Boot, Das (1981)" "Strictly Ballroom (1992)" "When Harry Met Sally... (1989)"
[13] "Forbidden Planet (1956)" "Amadeus (1984)" "American in Paris, An (1951)"
Dies ist eine Übersicht der Empfehlungen für die ersten 5 User. Wie erfordert, wurden jeweils 15 Empfehlungen generiert. Auf den ersten Blick werden viele unterschiedlichen Filme empfohlen.
# df funktion erstellen
topN_df <- function(topNList){
counts <- table(unlist(as.array(as(topNList, "list"))))
df <- data.frame(Movie = names(counts), Count = unname(counts)) %>%
select("Movie", "Count.Freq") %>%
rename("Count" = "Count.Freq") %>%
arrange(desc(Count))
df
}
# alle dfs erstellen
ribcftopN_df_1 <- topN_df(ribcftopNList_1)
ribcftopN_df_1
ribcftopN_df_2 <- topN_df(ribcftopNList_2)
ribcftopN_df_2
rubcftopN_df_1 <- topN_df(rubcftopNList_1)
rubcftopN_df_1
rubcftopN_df_2 <- topN_df(rubcftopNList_2)
rubcftopN_df_2
NA
Die ersten beiden Tabellen stellen die Empfehlungen und deren Anzahl basierend auf IBCF für die beiden Datensätze dar. In den Top 10 Empfehlungen sind sehr unterschiedliche Empfehlungen, es gibt kaum Überschneidungen. Für den ersten Datensatz wird ein Film maximal 11 mal, im zweiten maximal 15 mal empfohlen. Beim ersten Datensatz werden insgesamt 487 Filme und beim zweiten 407 empfohlen.
Die letzten beiden Tabellen stellen die Empfehlungen basierend auf UBCF für die beiden Datensätze dar. Die Top 10 Filme sind wieder sehr unterschiedlich. Grosse Unterschiede gibt es auch bei der Anzahl Vorkommen der Top Filme. Für den ersten Datensatz werden sie bis zu 30 mal empfohlen, während es beim zweiten maximal 14 mal war. Auch liegt die Anzahl Empfehlungen mit 301 vs 392 weit auseinander.
Für weitere Informationen visualisieren wir nun auch die Top Empfehlungen.
# funktion zur Visualisierung
top15_df_visualize <- function(topNList, subtitle){
topNList %>% head(15) %>%
ggplot(aes(x = reorder(Movie, Count), y = Count)) +
geom_bar(stat = "identity", fill = "limegreen", alpha = 0.5, color = "black") +
coord_flip() +
labs(x = "Movie",
y = "Anzahl",
title = "Top-15 Empfehlungen",
subtitle = subtitle)
}
grid.arrange(top15_df_visualize(ribcftopN_df_1, "ribcf 1"),
top15_df_visualize(rubcftopN_df_1, "rubcf 1"),
ncol = 2)
grid.arrange(top15_df_visualize(ribcftopN_df_2, "ribcf 2"),
top15_df_visualize(rubcftopN_df_2, "rubcf 2"),
ncol = 2)
Dank der library gridExtra können wir die beiden Datensätze nebeneinander darstellen. Ersichtlich wird, wie schnell die Anzahl Empfehlungen pro Film abnimmt. In der ersten Lasche, IBCF, sieht man, dass die Anzahl linear abnimmt, nachdem die ersten fünf Filme gleich häufig empfohlen werden. Hingegen nehmen die Anzahl im zweiten Datensatz (Grafik rechts) zuerst schnell, bis etwa zum Niveau des ersten Datensatzes, dann linear ab. Bei UBCF, in der zweiten Lasche, nimmt die Anzahl bei beiden Datensätzen linear ab.
Die erwähnte Behauptung “Recommender Systeme machen für alle Nutzer die gleichen Empfehlungen” kann dank der Tabellen und Histogramme verworfen werden. Es werden viele unterschiedliche Filme empfohlen, vieleviele Filme werden nur wenigen Usern (<4) empfohlen.
Aufgabe 6: Untersuche den Einfluss von Ratings (ordinale vs binäre Ratings) und Modelltyp (IBCF vs UBCF) auf Top-N Empfehlungen für den reduzierten Datensatz. Vergleiche den Anteil übereinstimmender Empfehlungen der Top-15 Liste für ## 6.1 IBCF vs UBCF, beide mit ordinalem Rating und Cosine Similarity für alle Testkunden,
compare_ibcf_ubcf <- function(ibcf, ubcf) {
print(paste("Anzahl IBCF:", nrow(ibcf)))
print(paste("Anzahl UBCF:", nrow(ubcf)))
IntersectordRatCosine <- intersect(ibcf$Movie, ubcf$Movie)
print(paste("Anzahl gemeinsame Empfehlungen:", length(IntersectordRatCosine)))
print(paste("Anteil IBCF:", length(IntersectordRatCosine) / nrow(ibcf) * 100))
print(paste("Anteil UBCF:", length(IntersectordRatCosine) / nrow(ubcf) * 100))
}
print("Erste Datenreduktion")
[1] "Erste Datenreduktion"
compare_ibcf_ubcf(ribcftopN_df_1, rubcftopN_df_1)
[1] "Anzahl IBCF: 487"
[1] "Anzahl UBCF: 301"
[1] "Anzahl gemeinsame Empfehlungen: 231"
[1] "Anteil IBCF: 47.4332648870637"
[1] "Anteil UBCF: 76.7441860465116"
print("Zweite Datenreduktion")
[1] "Zweite Datenreduktion"
compare_ibcf_ubcf(ribcftopN_df_2, rubcftopN_df_2)
[1] "Anzahl IBCF: 407"
[1] "Anzahl UBCF: 392"
[1] "Anzahl gemeinsame Empfehlungen: 226"
[1] "Anteil IBCF: 55.5282555282555"
[1] "Anteil UBCF: 57.6530612244898"
Erste Datenreduktion: Für IBCF werden 487 und UBCF 301 Filme empfohlen, dabei gibt es eine Übereinstimmung von 231 Filmen. Das entsprechen bei IBCF 47.5% und bei UBCF 76.7%. Zweite Datenreduktion: Für IBCF werden 407 und UBCF 392 Filme empfohlen, dabei gibt es eine Übereinstimmung von 226 Filmen. Das entsprechen bei IBCF 55% und bei UBCF 57%.
Insgesamt generieren also beide Methoden ähnliche Empfehlungen, rund die Hälfte bis 3/4 der Empfehlungen generiert auch die andere Methode. Auffällig ist hingegen beim ersten Datensatz, dass IBCF viel mehr Filme empfiehlt, während es beim zweiten etwa gleich viel sind.
Beim zweiten Datensatz ist auch der Anteil an Gemeinsamkeiten jeweils bei rund 55% und damit ausgeglichener als im ersten Datensatz. Ich kann mir vorstellen, dass das daran liegt, dass beim zweiten Datensatz die Sparsity der Matrix höher ist und damit mehr Spielraum offen ist.
training_bin_1 <- binarize(training_1, minRating = 4)
test_bin_1 <- binarize(test_1, minRating = 4)
training_bin_2 <- binarize(training_2, minRating = 4)
test_bin_2 <- binarize(test_2, minRating = 4)
ribcf_bin_1 <- Recommender(training_bin_1, "IBCF", param=list(k= 30, method = "jaccard"))
ribcf_bin_1
Recommender of type ‘IBCF’ for ‘binaryRatingMatrix’
learned using 320 users.
rubcf_bin_1 <- Recommender(training_bin_1, "UBCF", param=list(nn= 30, method = "jaccard"))
rubcf_bin_1
Recommender of type ‘UBCF’ for ‘binaryRatingMatrix’
learned using 320 users.
ribcf_bin_2 <- Recommender(training_bin_2, "IBCF", param=list(k= 30, method = "jaccard"))
ribcf_bin_2
Recommender of type ‘IBCF’ for ‘binaryRatingMatrix’
learned using 320 users.
rubcf_bin_2 <- Recommender(training_bin_2, "UBCF", param=list(nn= 30, method = "jaccard"))
rubcf_bin_2
Recommender of type ‘UBCF’ for ‘binaryRatingMatrix’
learned using 320 users.
ribcftopNList_bin_1 = predict(ribcf_bin_1, test_bin_1, n=15)
ribcftopNList_bin_1
Recommendations as ‘topNList’ with n = 15 for 80 users.
rubcftopNList_bin_1 = predict(rubcf_bin_1, test_bin_1, n=15)
rubcftopNList_bin_1
Recommendations as ‘topNList’ with n = 15 for 80 users.
ribcftopNList_bin_2 = predict(ribcf_bin_2, test_bin_2, n=15)
ribcftopNList_bin_2
Recommendations as ‘topNList’ with n = 15 for 80 users.
rubcftopNList_bin_2 = predict(rubcf_bin_2, test_bin_2, n=15)
rubcftopNList_bin_2
Recommendations as ‘topNList’ with n = 15 for 80 users.
ribcftopN_df_bin_1 <- topN_df(ribcftopNList_bin_1)
ribcftopN_df_bin_1
ribcftopN_df_bin_2 <- topN_df(ribcftopNList_bin_2)
ribcftopN_df_bin_2
rubcftopN_df_bin_1 <- topN_df(rubcftopNList_bin_1)
rubcftopN_df_bin_1
rubcftopN_df_bin_2 <- topN_df(rubcftopNList_bin_2)
rubcftopN_df_bin_2
NA
Diese Auswertung entspricht der, der vorherigen Aufgabe, nur dass dieses mal mit binären Ratings und Jaccard Similarity gearbeitet wurde. Es wird auch hier ersichtlich, dass die Empfehlungen sehr unterschiedlich sind. Bei IBCF (erste zwei Tabellen) werden für den ersten Datensatz die Top Filme sehr viel häufiger (39 mal vs 16 mal) empfohlen. Das gleiche Muster, wenn aber schwächer, ist bei den UBCF ersichtlich.
print("Erste Datenreduktion binaer")
[1] "Erste Datenreduktion binaer"
compare_ibcf_ubcf(ribcftopN_df_bin_1, rubcftopN_df_bin_1)
[1] "Anzahl IBCF: 87"
[1] "Anzahl UBCF: 447"
[1] "Anzahl gemeinsame Empfehlungen: 6"
[1] "Anteil IBCF: 6.89655172413793"
[1] "Anteil UBCF: 1.34228187919463"
print("Zweite Datenreduktion binaer")
[1] "Zweite Datenreduktion binaer"
compare_ibcf_ubcf(ribcftopN_df_bin_2, rubcftopN_df_bin_2)
[1] "Anzahl IBCF: 411"
[1] "Anzahl UBCF: 519"
[1] "Anzahl gemeinsame Empfehlungen: 296"
[1] "Anteil IBCF: 72.0194647201946"
[1] "Anteil UBCF: 57.0327552986513"
Im Gegensatz zur vorherigen Aufgabe und den zweiten Datensatz, gibt es für den ersten fast keine gemeinsame Empfehlungen. Es fällt auch auf, dass für IBCF nur 87 Filme empfohlen werden. Diese Auswertung wurde mit minRating 4 für die binäre Klassifizierung berechnet. Mit Rating 3 sieht dieser Sachverhalt ähnlich aus, bei minRating 5 ist die Übereinstimmung aber wieder im normalen Bereich. Wieso minRating 3 und 4 so tiefe Übereinstimmungen generiert haben, können wir nicht nachvollziehe. Dass minRating 5 aber bessere Resultate generiert, liegt daran, dass nun nur noch wenige Items als 1 klassifiziert werden und damit weniger Filme zur Empfehlung zur Verfügung stellen.
compare_ubcf <- function(ibcf, ubcf) {
print(paste("Anzahl UBCF ord:", nrow(ibcf)))
print(paste("Anzahl UBCF bin:", nrow(ubcf)))
IntersectordRatCosine <- intersect(ibcf$Movie, ubcf$Movie)
print(paste("Anzahl gemeinsame Empfehlungen:", length(IntersectordRatCosine)))
print(paste("Anteil UBCF ord:", length(IntersectordRatCosine) / nrow(ibcf) * 100))
print(paste("Anteil UBCF bin:", length(IntersectordRatCosine) / nrow(ubcf) * 100))
}
Erstellung der Funktion und Berechnung des Resultats
print("Erste Datenreduktion")
[1] "Erste Datenreduktion"
compare_ubcf(rubcftopN_df_1, rubcftopN_df_bin_1)
[1] "Anzahl UBCF ord: 301"
[1] "Anzahl UBCF bin: 447"
[1] "Anzahl gemeinsame Empfehlungen: 207"
[1] "Anteil UBCF ord: 68.7707641196013"
[1] "Anteil UBCF bin: 46.3087248322148"
print("Zweite Datenreduktion")
[1] "Zweite Datenreduktion"
compare_ubcf(rubcftopN_df_2, rubcftopN_df_bin_2)
[1] "Anzahl UBCF ord: 392"
[1] "Anzahl UBCF bin: 519"
[1] "Anzahl gemeinsame Empfehlungen: 301"
[1] "Anteil UBCF ord: 76.7857142857143"
[1] "Anteil UBCF bin: 57.9961464354528"
Beim Vergleich von UBCF mit ordinalem und binärem Rating werden wieder mehr übereinstimmende Filme empfohlen. Für den ersten Datensatz werden 207 Filme bei beiden Modellen und beim zweiten Datensatz 301 übereinstimmende Filme empfohlen. Da bei beiden Datensätzen mit ordinalem Rating weniger Empfehlungen generiert werden, ist der Anteil Übereinstimmungen bei ordinalen Ratings entsprechend höher.
Aufgabe 7: Vergleiche Memory-based IBCF und Modell-based SVD Recommenders bezüglich Überschneidung ihrer Top-N Empfehlungen für die User-Item Matrix des reduzierten Datensatzes (Basis: reduzierter Datensatz, IBCF mit 30 Nachbarn und Cosine Similarity). Vergleiche wie sich der Anteil übereinstimmender Empfehlungen der Top-15 Liste für IBCF vs verschiedene SVD Modelle verändert, wenn die Anzahl der Singulärwerte für SVD von 10 auf 20, 30, 40, 50 verändert wird.
# Funktion fuer SVD Model
generate_SVD_topN_recomm <- function(train, test, svd_value = ksvd){
recom_model <- Recommender(train, "SVD", param=list(k= svd_value))
top_n_recom <- predict(recom_model, test, n=15)
top_n_recom
}
# Funktion fuer verschiedene N
generate_SVD_topN_lists <- function(train, test, N_values) {
rsvd_topN_lists <- list()
for (i in 1:length(N_values)) {
N <- N_values[i]
list_name <- paste0("rsvd", N, "topNList")
rsvd_topN_lists[[list_name]] <- generate_SVD_topN_recomm(train, test, N)
}
rsvd_topN_lists
}
Funktion zur Berechnung des Resultats
N_values <- c(10, 20, 30, 40, 50)
rsvd_topN_lists_1 <- generate_SVD_topN_lists(training_1, test_1, N_values)
print("Erster Datensatz")
[1] "Erster Datensatz"
rsvd_topN_lists_1
$rsvd10topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
$rsvd20topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
$rsvd30topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
$rsvd40topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
$rsvd50topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
rsvd_topN_lists_2 <- generate_SVD_topN_lists(training_2, test_2, N_values)
print("Zweiter Datensatz")
[1] "Zweiter Datensatz"
rsvd_topN_lists_2
$rsvd10topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
$rsvd20topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
$rsvd30topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
$rsvd40topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
$rsvd50topNList
Recommendations as ‘topNList’ with n = 15 for 80 users.
generate_topN_dfs <- function(rsvd_topN_lists) {
topN_dfs <- list()
for (i in 1:length(rsvd_topN_lists)) {
list_name <- names(rsvd_topN_lists)[i]
df_name <- paste0(list_name, "_df")
topN_dfs[[df_name]] <- topN_df(rsvd_topN_lists[[i]])
}
topN_dfs
}
topN_df_svd_1 <- generate_topN_dfs(rsvd_topN_lists_1)
print("Erster Datensatz")
[1] "Erster Datensatz"
topN_df_svd_1
$rsvd10topNList_df
$rsvd20topNList_df
$rsvd30topNList_df
$rsvd40topNList_df
$rsvd50topNList_df
topN_df_svd_2 <- generate_topN_dfs(rsvd_topN_lists_2)
print("Zweiter Datensatz")
[1] "Zweiter Datensatz"
topN_df_svd_2
$rsvd10topNList_df
$rsvd20topNList_df
$rsvd30topNList_df
$rsvd40topNList_df
$rsvd50topNList_df
NA
Die ersten fünf Tabellen sind die Resultate für den ersten Datensatz. Es handelt sich aufsteigend um die Anzahl Singulärwerte von 10 bis 50. Die letzten fünf Tabellen beinhalten das gleiche Resultat, einfach für den zweiten Datensatz. Diese Auswertung wird noch nicht für die Beantwortung der Aufgabe verwendet, sondern gab uns einen ersten Überblick über die Resultate
compare_ibcf_svd <- function(ribcf, svd, svd_value) {
intersect <- intersect(ribcf$Movie, svd$Movie)
print(paste("Anzahl gemeinsame Empfehlungen SVD", svd_value, ":", length(intersect)))
print(paste("Gemeinsamer relativer Anteil für Anzahl Singulärwerte", svd_value, ":", length(intersect) / nrow(ribcf) * 100))
}
print("Erster Datensatz")
[1] "Erster Datensatz"
compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd10topNList_df, 10)
[1] "Anzahl gemeinsame Empfehlungen SVD 10 : 76"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 10 : 15.605749486653"
compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd20topNList_df, 20)
[1] "Anzahl gemeinsame Empfehlungen SVD 20 : 86"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 20 : 17.6591375770021"
compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd30topNList_df, 30)
[1] "Anzahl gemeinsame Empfehlungen SVD 30 : 93"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 30 : 19.0965092402464"
compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd40topNList_df, 40)
[1] "Anzahl gemeinsame Empfehlungen SVD 40 : 105"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 40 : 21.5605749486653"
compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd50topNList_df, 50)
[1] "Anzahl gemeinsame Empfehlungen SVD 50 : 117"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 50 : 24.0246406570842"
print("Zweiter Datensatz")
[1] "Zweiter Datensatz"
compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd10topNList_df, 10)
[1] "Anzahl gemeinsame Empfehlungen SVD 10 : 10"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 10 : 2.45700245700246"
compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd20topNList_df, 20)
[1] "Anzahl gemeinsame Empfehlungen SVD 20 : 20"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 20 : 4.91400491400491"
compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd30topNList_df, 30)
[1] "Anzahl gemeinsame Empfehlungen SVD 30 : 24"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 30 : 5.8968058968059"
compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd40topNList_df, 40)
[1] "Anzahl gemeinsame Empfehlungen SVD 40 : 27"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 40 : 6.63390663390663"
compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd50topNList_df, 50)
[1] "Anzahl gemeinsame Empfehlungen SVD 50 : 27"
[1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 50 : 6.63390663390663"
Für den ersten Datensatz werden bei SVD Wert 10 76 gemeinsame Empfehlungen mit IBCF generiert. Dies entspricht einem Anteil von 15.6% der Empfehlungen vom SVD Modell. Bis zur Anzahl von 50 Singulärwerten steigt die Anzahl gemeinsamer Empfehlungen auf 117, was einem Anteil von 24% entspricht.
Aufgabe 8 (DIY) ## 8.1 CoverageN
ribcf_8 <- Recommender(MovieLense, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_8
ribcftopNList_8 <- predict(ribcf_8, MovieLense, n=15)
ribcftopNList_8
list_items_8 <- unique(unlist(as(ribcftopNList_8, "list"), use.names = FALSE))
len_items_8 <- length(list_items_8)
len_all_items_8 <- dim(MovieLense)[2]
len_all_items_8
coverageN <- len_items_8 / len_all_items_8
coverageN
41.7 % der vorhandenen Filme werden empfohlen.
nratings(MovieLense) / len_all_items_8
Aufgabe 9 ## 9.1 Verwende für die Evaluierung 10-fache Kreuzvalidierung
set.seed(1234)
scheme_1 <- evaluationScheme(MovieLenseCompact_1, method="cross-validation", k = 10, given=3, goodRating=5)
scheme_2 <- evaluationScheme(MovieLenseCompact_2, method="cross-validation", k = 10, given=3, goodRating=5)
print("Erste Datenreduktion")
scheme_1
print("Zweite Datenreduktion")
scheme_2
algorithms <- list("hybrid" = list(name = "HYBRID", param =list(recommenders = list(SVD = list(name="SVD", param=list(k = 40)),
POPULAR = list(name = "POPULAR", param = NULL)
))),
"libmf" = list(name="LIBMF", param=list(dim=10)),
"popular items" = list(name="POPULAR", param=NULL),
"user-based CF" = list(name="UBCF", param=list(nn=50)),
"item-based CF" = list(name="IBCF", param=list(k=50)),
"SVD40" = list(name="SVD", param=list(k = 40)))
print("Erster Datensatz")
results_1 <- evaluate(scheme_1, algorithms, type = "topNList", n=c(10, 15, 20, 25, 30))
print("Zweiter Datensatz")
results_2 <- evaluate(scheme_2, algorithms, type = "topNList", n=c(10, 15, 20, 25, 30))
plot(results_1, annotate=c(1,3), legend="topleft")
plot(results_2, annotate=c(1,3), legend="topleft")
vieles blabaalabaaassss
algorithmsimprovedrecom <- list("popular items center" = list(name="POPULAR", param=NULL),
"popular items Z-score" = list(name="POPULAR", param=list(normalize="Z-score")))
resultsimprovedrecom_1 <- evaluate(scheme_1, algorithmsimprovedrecom, type = "topNList", n=c(10, 15, 20, 25, 30))
resultsimprovedrecom_2 <- evaluate(scheme_2, algorithmsimprovedrecom, type = "topNList", n=c(10, 15, 20, 25, 30))
plot(resultsimprovedrecom_1, annotate=c(1,3), legend="topleft")
plot(resultsimprovedrecom_2, annotate=c(1,3), legend="topleft")
Hinweis: Verwende für den Top-Movie Recommender die Filme mit den höchsten Durchschnittsratings. # 10 Implementierung Top-N Monitor Aufgabe 10 (DIY): Untersuche die relative Übereinstimmung zwischen Top-N Empfehlungen und präferierten Filmen für 4 unterschiedliche Modelle (z.B. IBCF und UBCF mit unterschiedlichen Ähnlichkeitsmetriken / Nachbarschaften sowie SVD mit unterschiedlicher Dimensionalitätsreduktion).
# select 20 random users
set.seed(1234)
testUsers <- sample(1:nrow(MovieLense), 20)
testUsers
# filter MovieLense by testUsers
MovieLenseTest <- MovieLense[testUsers,]
MovieLenseTest
# get from every TestUsers the Top_N item list
ribcf_10 <- Recommender(MovieLenseTest, "IBCF", param=list(k= 30, method = "cosine"))
# predict Top-N items for every user
ribcftopNList_10 <- predict(ribcf_10, MovieLenseTest, n=15)
# create a list with the topN items for every user
ribcftopNList_10_list <- as(ribcftopNList_10, "list")
# create a tibble with the topN items for every user
ribcftopNList_10_tibble <- as_tibble(ribcftopNList_10_list)
# transform the tibble to a data frame
ribcftopNList_10_df <- as.data.frame(ribcftopNList_10_tibble)
# replace colname with testUsers
colnames(ribcftopNList_10_df) <- testUsers
# transpose data frame
ribcftopNList_10_df_transposed <- t(ribcftopNList_10_df)
# change ribcftopNList_10_df_transposed to a tibble
ribcftopNList_10_df_transposed_tibble <- as_tibble(ribcftopNList_10_df_transposed)
# add a column with the testUsers
ribcftopNList_10_df_transposed_tibble$testUsers <- testUsers
# pivot longer dataframe
ribcftopNList_10_df_transposed_tibble_pivot <- pivot_longer(ribcftopNList_10_df_transposed_tibble, cols = 1:15, names_to = "topN", values_to = "itemID")
# get genre from each item
ribcftopNList_10_df_transposed_tibble_pivot_genre <- left_join(ribcftopNList_10_df_transposed_tibble_pivot, MovieLenseMeta, by = c("itemID" = "title"))
ribcftopNList_10_df_transposed_tibble_pivot_genre
# drop columns topN, year, url
ribcftopNList_10_df_transposed_tibble_pivot_genre <- select(ribcftopNList_10_df_transposed_tibble_pivot_genre, -topN, -year, -url, -itemID)
ribcftopNList_10_df_transposed_tibble_pivot_genre
# pivot longer dataframe
ribcftopNList_10_df_transposed_tibble_pivot_genre %>% group_by(testUsers) %>%
summarise(across(everything(), ~ sum(., is.na(.), 0)))
(=Filme mit besten Bewertungen),